home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / you-075a.lha / you-075a / sio.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-06-18  |  6.3 KB  |  335 lines
  1. /* ******************************************************************** */
  2. /* sio.c             Copyright (C) Codemist and University of Bath 1989 */
  3. /*                                                                      */
  4. /* String IO (mainly for sockets)                                    */
  5. /* ******************************************************************** */
  6.  
  7. #define PAUSE() 
  8.  
  9. /*
  10.  * Change Log:
  11.  *   Version 1, June 1990
  12.  */
  13.  
  14. #include <string.h>
  15.  
  16. #include "funcalls.h"
  17. #include "defs.h"
  18. #include "structs.h"
  19. #include "error.h"
  20. #include "global.h"
  21.  
  22. #include "allocate.h"
  23.  
  24. #include "symboot.h"
  25. #include "syssockets.h"
  26. #include "sio.h"
  27.  
  28. /*
  29.  
  30.  * Socket reader/writer... 
  31.  
  32.  */
  33.  
  34. SYSTEM_THREAD_SPECIFIC_DECLARATION(LispObject,socket_buffer_form);
  35. SYSTEM_THREAD_SPECIFIC_DECLARATION(char *,socket_buffer);
  36. SYSTEM_THREAD_SPECIFIC_DECLARATION(int,socket_buffer_ptr);
  37.  
  38. #define BUFFER_LEFT() (SOCKET_BUFFER_SIZE - \
  39.                SYSTEM_THREAD_SPECIFIC_VALUE(socket_buffer_ptr))
  40. #define BUFFER_PTR() (SYSTEM_THREAD_SPECIFIC_VALUE(socket_buffer_ptr))
  41. #define BUFFER() (SYSTEM_THREAD_SPECIFIC_VALUE(socket_buffer) +\
  42.           SYSTEM_THREAD_SPECIFIC_VALUE(socket_buffer_ptr))
  43. #define BUFFER_START() (SYSTEM_THREAD_SPECIFIC_VALUE(socket_buffer))
  44. #define BUFFER_FORM() (SYSTEM_THREAD_SPECIFIC_VALUE(socket_buffer_form))
  45.  
  46. /*
  47.  
  48.  * Writing... 
  49.  
  50.  */
  51.  
  52. void write_symbol(LispObject *stacktop,LispObject sym)
  53. {
  54.   int len = strlen(stringof(sym->SYMBOL.pname));
  55.  
  56.   if (BUFFER_LEFT() <= len)
  57.     CallError(stacktop,"socket-write: form too big",BUFFER_FORM(),NONCONTINUABLE);
  58.  
  59.   sprintf(BUFFER(),"%s",stringof(sym->SYMBOL.pname));
  60.  
  61.   BUFFER_PTR() += len;
  62. }
  63.  
  64. void write_integer(LispObject *stacktop,LispObject i)
  65. {
  66.   char buf[50];
  67.   int len;
  68.  
  69.   /* Bugger length... */
  70.  
  71.   sprintf(buf,"%d\0",intval(i));
  72.  
  73.   len = strlen(buf);
  74.  
  75.   if (BUFFER_LEFT() <= len)
  76.     CallError(stacktop,
  77.           "socket-write: form too big",BUFFER_FORM(),NONCONTINUABLE);
  78.  
  79.   strcpy(BUFFER(),buf);
  80.  
  81.   BUFFER_PTR() += len;
  82. }
  83.  
  84. void write_float(LispObject *stacktop,LispObject f)
  85. {
  86.   char buf[50];
  87.   int len;
  88.  
  89.   sprintf(buf,"%lf\0",f->FLOAT.fvalue);
  90.   len = strlen(buf);
  91.  
  92.   if (BUFFER_LEFT() <= len)
  93.     CallError(stacktop,
  94.           "socket-write: form too long",BUFFER_FORM(),NONCONTINUABLE);
  95.  
  96.   strcpy(BUFFER(),buf);
  97.   BUFFER_PTR() += len;
  98. }
  99.  
  100. void write_string(LispObject s)
  101. {
  102.   sprintf(BUFFER(),"\"%s\"",stringof(s));
  103.   BUFFER_PTR() += strlen(stringof(s)) + 2;
  104. }
  105.  
  106. void write_cons(LispObject *stacktop,LispObject l)
  107. {
  108.   if (BUFFER_LEFT() < 3)
  109.     CallError(stacktop,
  110.           "socket-write: form too big",BUFFER_FORM(),NONCONTINUABLE);
  111.  
  112.   if (l == nil) {
  113.     sprintf(BUFFER(),"()");
  114.     BUFFER_PTR() += 2;
  115.     return;
  116.   }
  117.  
  118.   sprintf(BUFFER(),"(");
  119.   
  120.   BUFFER_PTR() += 1;
  121.  
  122.   while (is_cons(CDR(l))) {
  123.     
  124.     write_object(stacktop,CAR(l));
  125.  
  126.     sprintf(BUFFER()," ");
  127.  
  128.     BUFFER_PTR() += 1;
  129.  
  130.     l = CDR(l);
  131.  
  132.   }
  133.  
  134.   if (CDR(l) != nil) {
  135.  
  136.     write_object(stacktop,CAR(l));
  137.  
  138.     sprintf(BUFFER()," . ");
  139.  
  140.     BUFFER_PTR() += 3;
  141.  
  142.     write_object(stacktop,CDR(l));
  143.  
  144.   }
  145.   else {
  146.  
  147.     write_object(stacktop,CAR(l));
  148.  
  149.   }
  150.  
  151.   sprintf(BUFFER(),")");
  152.  
  153.   ++BUFFER_PTR();
  154. }
  155.  
  156. void write_object(LispObject *stacktop,LispObject obj)
  157. {
  158.   switch (typeof(obj)) {
  159.  
  160.   case TYPE_SYMBOL: 
  161.     write_symbol(stacktop,obj);
  162.     return;
  163.   case TYPE_INT:
  164.     write_integer(stacktop,obj);
  165.     return;
  166.   case TYPE_FLOAT:
  167.     write_float(stacktop,obj);
  168.     return;
  169.   case TYPE_NULL:
  170.   case TYPE_CONS:
  171.     write_cons(stacktop,obj);
  172.     return;
  173.   case TYPE_STRING:
  174.     write_string(obj);
  175.     return;
  176.   default:
  177.     CallError(stacktop,"socket-write: unwriteable object",obj,NONCONTINUABLE);
  178.  
  179.   }
  180. }
  181.  
  182. /* 
  183.  
  184.  * Reading... 
  185.  
  186.  */
  187.  
  188. #define iswhitespace(c) (c == ' ' || c == '\t' || c == '\n')
  189.  
  190. #define BUFFER_PEEK() (*((SYSTEM_THREAD_SPECIFIC_VALUE(socket_buffer) \
  191.               + SYSTEM_THREAD_SPECIFIC_VALUE(socket_buffer_ptr))))
  192.  
  193. LispObject read_number(LispObject *stacktop)
  194. {
  195.   int num;
  196.  
  197.   sscanf(BUFFER(),"%d",&num);
  198.   ++BUFFER_PTR();
  199.  
  200.   while(isdigit(BUFFER_PEEK())) ++BUFFER_PTR();
  201.  
  202.   while(iswhitespace(BUFFER_PEEK())) ++BUFFER_PTR();
  203.  
  204.   return((LispObject) allocate_integer(stacktop,num));
  205. }
  206.  
  207. LispObject read_symbol(LispObject *stacktop)
  208. {
  209.   char name[100];
  210.   int i = 0;
  211.  
  212.   while (!iswhitespace(BUFFER_PEEK()) 
  213.      && BUFFER_PEEK() != ')'
  214.      && BUFFER_PEEK() != '.'
  215.      && BUFFER_PEEK() != '\0') {
  216.  
  217.     name[i] = BUFFER_PEEK();
  218.     ++BUFFER_PTR();
  219.     ++i;
  220.  
  221.   }
  222.  
  223.   name[i] = '\0';
  224.  
  225.   while(iswhitespace(BUFFER_PEEK())) ++BUFFER_PTR();
  226.  
  227.   return(get_symbol_by_copying(stacktop,name));
  228. }
  229.  
  230. LispObject read_string(LispObject *stacktop)
  231. {
  232.   char string[160];
  233.   int i = 0;
  234.  
  235.   ++BUFFER_PTR();
  236.  
  237.   while (BUFFER_PEEK() != '"') {
  238.  
  239.     string[i] = BUFFER_PEEK();
  240.     ++BUFFER_PTR(); ++i;
  241.  
  242.   }
  243.  
  244.   string[i] = '\0';
  245.  
  246.   ++BUFFER_PTR();
  247.  
  248.   while(iswhitespace(BUFFER_PEEK())) ++BUFFER_PTR();
  249.  
  250.   return((LispObject) allocate_string(stacktop,string,i));
  251.  
  252. }
  253.     
  254. LispObject read_list(LispObject *stacktop)
  255. {
  256.   extern LispObject Fn_nconc(LispObject*);
  257.   LispObject read_object(LispObject*);
  258.   LispObject kludge = nil;
  259.  
  260.   PAUSE();
  261.  
  262.   ++BUFFER_PTR();
  263.  
  264.   while (BUFFER_PEEK() != ')' && BUFFER_PEEK() != '.') {
  265.     LispObject xx;
  266.     STACK_TMP(kludge);
  267.     EUCALLSET_2(xx, Fn_cons, read_object(stacktop), nil);
  268.     UNSTACK_TMP(kludge);
  269.     EUCALLSET_2(kludge, Fn_nconc, kludge, xx);
  270.  
  271.     while (iswhitespace(BUFFER_PEEK())) ++BUFFER_PTR();
  272.  
  273.     PAUSE();
  274.  
  275.   }
  276.  
  277.   if (BUFFER_PEEK() == '.') {
  278.  
  279.     ++BUFFER_PTR();
  280.     EUCALLSET_2(kludge, Fn_nconc,kludge,read_object(stacktop));
  281.     while (iswhitespace(BUFFER_PEEK())) ++BUFFER_PTR();
  282.  
  283.     if (BUFFER_PEEK() != ')')
  284.       CallError(stacktop,"socket-read: invalid list (. a b)",BUFFER_FORM(),
  285.         NONCONTINUABLE);
  286.  
  287.   }
  288.  
  289.   ++BUFFER_PTR();
  290.  
  291.   while(iswhitespace(BUFFER_PEEK())) ++BUFFER_PTR();
  292.  
  293.   return(kludge);
  294. }
  295.  
  296. LispObject read_quote(LispObject *stacktop)
  297. {
  298.   LispObject read_object(LispObject*);
  299.  
  300.   LispObject kludge = nil;
  301.  
  302.   ++BUFFER_PTR();
  303.  
  304.   STACK(kludge);
  305.  
  306.   EUCALLSET_2(kludge, Fn_cons,read_object(stacktop),nil);
  307.   EUCALLSET_2(kludge, Fn_cons,sym_quote,kludge);
  308.  
  309.   UNSTACK(1);
  310.  
  311.   return(kludge);
  312. }
  313.   
  314. LispObject read_object(LispObject *stacktop)
  315. {
  316.   char c = BUFFER_PEEK();
  317.  
  318.   while (iswhitespace(c)) {
  319.  
  320.     ++BUFFER_PTR();
  321.     c = BUFFER_PEEK();
  322.  
  323.   }
  324.  
  325.   PAUSE();
  326.  
  327.   if (c == '(') return(read_list(stacktop));
  328.   if (c == '\'') return(read_quote(stacktop));
  329.   if (c == '"') return(read_string(stacktop));
  330.   if (isdigit(c) || c == '-' || c == '+') return(read_number(stacktop));
  331.  
  332.   return(read_symbol(stacktop));
  333. }
  334.  
  335.